Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/smtlbox/frmmain.txt

Text File | 1994-10-16 | 10KB | 338 lines

'General Declarations
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Declare Function Sendmessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Sub ReleaseCapture Lib "User" ()
Declare Function GetactiveWindow Lib "User" () As Integer

Dim Focus As Integer

'//////////////////////////////////////////////////
' WINDOWBUILD
'//////////////////////////////////////////////////

Sub Form_GotFocus ()
TitleBarObject.BackColor = active_Title_BAr
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_KeyDown (KEYCODE As Integer, Shift As Integer)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim ShiftDown, Altdown, CtrlDown

   Const KEY_F4 = &H73
    'Const KEY_F2 = &H71 ' Define constants.

    Const ALT_MASK = 4
    Altdown = (Shift And ALT_MASK) > 0


    If KEYCODE = KEY_sPACE Then    ' Display key combinations.

    If ShiftDown And CtrlDown And Altdown Then

    ElseIf ShiftDown And Altdown Then

    ElseIf ShiftDown And CtrlDown Then

    ElseIf CtrlDown And Altdown Then

    ElseIf ShiftDown Then

    ElseIf CtrlDown Then

    ElseIf Altdown Then
    picControlMenu_Mouseup 1, 0, 0, 0

    ElseIf Shift = 0 Then

    End If

    End If

    If KEYCODE = KEY_F4 Then
    If Altdown Then
    End
    End If
    End If
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

End Sub

Sub Form_Load ()

    Call WindowBuild(frmMain, WindowBorder1, TitleBarObject, picControlMenu)
    ' Pass it the names of the objects that make up the Window.' Call WindowBuild a second time to eliminate flicker
        Call WindowBuild(frmMain, WindowBorder2, TitleBarObject, picControlMenu)
            Focus = True 'To color the window approprietly
                Timer1.Interval = 10 'Enable timer to catch events
' Code for "INI" File
   ' frmMain.Top = GetPrivateProfileInt(SECTION, "Top", 0, INIFILENAME)
   ' frmMain.Left = GetPrivateProfileInt(SECTION, "Left", 0, INIFILENAME)
   ' frmMain.Height = GetPrivateProfileInt(SECTION, "Height", Screen.Height, INIFILENAME)
   ' frmMain.Width = GetPrivateProfileInt(SECTION, "Width", Screen.Width, INIFILENAME)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
        End Sub

Sub Form_LostFocus ()
Dim i As Integer
i = GetactiveWindow()
MsgBox "" + Str$(i)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

If Focus = True Then
    TitleBarObject.BackColor = active_Title_BAr
Else
    TitleBarObject.BackColor = active_Title_BAr
End If
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Focus = True
Timer1.Interval = 10
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_Resize ()
WindowBuild frmMain, WindowBorder1, TitleBarObject, picControlMenu
WindowBuild frmMain, WindowBorder2, TitleBarObject, picControlMenu
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim rc As Integer

    'Create the INI file
    rc = WritePrivateProfileString(SECTION, ByVal "Top", ByVal Str$(frmMain.Top), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Left", ByVal Str$(frmMain.Left), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Height", ByVal Str$(frmMain.Height), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Width", ByVal Str$(frmMain.Width), INIFILENAME)


    'Terminate the application
    End
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_DblClick ()
Unload frmMain
End
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Mousedown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Focus = True
Timer1.Interval = 10
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Mouseup (Button As Integer, Shift As Integer, X As Single, Y As Single)
TitleBarObject.BackColor = active_Title_BAr
mousepointer = 5
Focus = True
Timer1.Interval = 10
PopupMenu frmDummy.mnuSystemMenu, 0, 0, 9
mousepointer = 0
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Resize ()
picControlMenu.Picture = Image1(1).Picture
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Timer1_Timer ()
   If Focus = True Then

    If GetactiveWindow() <> frmMain.hWnd Then
       'Do form's lost-focus routines here.

       Focus = False
       WindowBorder1.BorderColor = Inactive_Border
       TitleBarObject.BackColor = inactive_Title_BAr
    Else
      Focus = True
    End If

   End If
'Only Event for this object
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub TitleBarObject_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

Focus = True
    Timer1.Interval = 10
    If Button <> 1 Then Exit Sub ' If not the left mouse button, ...exit
    Dim ReturnVal%
    ReleaseCapture
    ReturnV